Long-term scenarios of daily deaths

CZ_expected_deaths_timeline_projected_end <- CZ_expected_deaths_timeline_projected %>%
  filter(date_expected_death == date_view_model_end)

CZ_expected_deaths_timeline_projected_summary <- CZ_expected_deaths_timeline_projected %>%
  mutate(month = month(date_expected_death),
         year = year(date_expected_death)) %>%
  group_by(year, month, Scenario) %>%
  summarise(expected_deaths = sum(expected_deaths)) %>%
  mutate(date = paste("15/", month, "/", year),
         date = dmy(date))


ggplotly(
CZ_expected_deaths_timeline_projected %>% 
  left_join(CZ_all, by = c("date_expected_death" = "date")) %>%
  filter(date_expected_death <= date_view_model_end) %>%
  filter(date_expected_death >= date_view_model_start) %>%
  ggplot(aes(x = date_expected_death, y = round(expected_deaths_7,2), col = Scenario)) +
  geom_line(size = 1) +
  geom_text_repel(aes(label = round(expected_deaths_7,0), colour = Scenario), data = CZ_expected_deaths_timeline_projected_end, size = 3, vjust = 0, hjust = -200) +
  #geom_line(aes(y = expected_deaths), col = "grey10") +
  geom_line(aes(y = new_deaths_7), col = "black", size = 1) +
  geom_vline(xintercept = date_model, col = "red", linetype = "dashed") +
  scale_color_manual(values = c("#4DAF4A", "#377EB8", "purple", "#E41A1C")) +
  scale_x_date(date_breaks = "1 month", date_minor_breaks = "1 week", date_labels="%b") +
  theme_light() +
  theme(panel.grid.minor = element_blank(),
        legend.position = "bottom") +
  guides(color=guide_legend(nrow=2,byrow=TRUE)) +
  labs(y = "Deaths (7 day rolling average)", x = "", title = "Scenarios of expected daily deaths", subtitle = "Based on past data and 4 scenarios of growth in cases") 
) %>%
  layout(legend = list(
    orientation = "h",
    x = -0,
    y = -0.1
  )
)
CZ_expected_deaths_timeline_projected_end <- CZ_expected_deaths_timeline_projected %>%
  filter(date_expected_death == date_view_model_end)

CZ_expected_deaths_timeline_projected_summary <- CZ_expected_deaths_timeline_projected %>%
  mutate(month = month(date_expected_death),
         year = year(date_expected_death)) %>%
  group_by(year, month, Scenario) %>%
  summarise(expected_deaths = sum(expected_deaths)) %>%
  mutate(date = paste("15/", month, "/", year),
         date = dmy(date))



CZ_expected_deaths_timeline_projected %>% 
  left_join(CZ_all, by = c("date_expected_death" = "date")) %>%
  filter(date_expected_death <= date_view_model_end) %>%
  filter(date_expected_death >= date_view_model_start) %>%
  ggplot(aes(x = date_expected_death, y = round(expected_deaths_7,2), col = Scenario)) +
  geom_line(size = 1) +
  geom_text_repel(aes(label = round(expected_deaths_7,0), colour = Scenario), data = CZ_expected_deaths_timeline_projected_end, size = 3, vjust = 0, hjust = -1) +
  # geom_text(aes(x = date, y = 0, label = round(expected_deaths,0), colour = Scenario), data = CZ_expected_deaths_timeline_projected_summary %>% filter(Scenario == "My projection") %>% filter(date <= date_view_model_end) %>%
  # filter(date >= date_view_model_start), size = 3, vjust = -1, hjust = 0) +
  #geom_line(aes(y = expected_deaths), col = "grey10") +
  geom_line(aes(y = new_deaths_7), col = "black", size = 1) +
  geom_vline(xintercept = date_model, col = "red", linetype = "dashed") +
  scale_color_manual(values = c("#4DAF4A", "#377EB8", "purple", "#E41A1C")) +
  scale_x_date(date_breaks = "1 month", date_minor_breaks = "1 week", date_labels="%b") +
  theme_light() +
  theme(panel.grid.minor = element_blank(),
        legend.position = "bottom") +
  guides(color=guide_legend(nrow=2,byrow=TRUE)) +
  labs(y = "Deaths (7 day rolling average)", x = "", title = "Scenarios of expected daily deaths", subtitle = "Based on past data and 4 scenarios of growth in cases")

Model description

6) Finally sum up each age category to get the overall projection

The End! Sort of, review output corresponds to past reality -> if not adjust model.

7) Additional step for “complex” model

To adjust for a slightly less accurate projection in the second wave I incorporated % of positive tests (positivity) as a measure of how early/late people get tested. I found that the % of positive tests doesn’t increase fatality (at least according to official covid data), but a high % of positive tests meant people were tested 2-3 days later than usual, meaning people died earlier than my model projected.

To adjust for that I developped a scalar which adjusts the probabilities of the delay between people being tested and dying. In simpler terms if positivity is > 20%, people die earlier than in the baseline model and if positivity < 20% people die later. The scalar hits its maximum level (adjustment) when positivity hits 33% -> adjusts delay by 2-3 days.

However, recently the introduction of AG testing seems to alter the relation between positivity and delay to testing as people are being tested “on time” despite a higher PCR positivity rate.